perm filename C.F4[TMP,LCS] blob
sn#496908 filedate 1980-02-06 generic text, type T, neo UTF8
00100 IMPLICIT INTEGER (A-Z)
00200 DATA A/100/,B/500/,C/300/,D/100/
00300 1 FORMAT(' TYPE INITIAL X,Y '$)
00400 2 FORMAT(10I)
00500 TYPE 1
00600 ACCEPT 2,XX,YY
00700 3 FORMAT(' TYPE NEXT X,Y '$)
00800 4 TYPE 3
00900 ACCEPT 2,X2,Y2
01000 X1=XX
01100 Y1=YY
01200 XX=X2
01300 YY=Y2
01400 IF(X1.LT.A.AND.X2.LT.A)GO TO 4
01500 IF(X1.GT.C.AND.X2.GT.C)GO TO 4
01600 IF(Y1.LT.D.AND.Y2.LT.D)GO TO 4
01700 IF(Y1.GT.B.AND.Y2.GT.B)GO TO 4
01800 100 CALL CL(X1,X2,Y1,Y2,W1,W2,Z1,Z2,A,C)
01900 IF(Z1.LT.D.AND.Z2.LT.D)GO TO 4
02000 IF(Z1.GT.B.AND.Z2.GT.B)GO TO 4
02100 200 CALL CL(Z1,Z2,W1,W2,Y1,Y2,X1,X2,D,B)
02200 300 TYPE 2,X1,Y1,X2,Y2
02300 GO TO 4
02400 END
02500
02600 SUBROUTINE CL(X1,X2,Y1,Y2,W1,W2,Z1,Z2,A,C)
02700 IMPLICIT INTEGER (A-Z)
02750 REAL Q,R
02760 R=X2-X1
02800 1 Q=(Y2-Y1)/R
02900 2 W1=WX(X1,A,C)
03000 3 Z1=Q*(W1-X1)+Y1
03100 4 W2=WX(X2,A,C)
03200 C5 Z2=Q*(W2-X1)+Y1
03250 5 Z2=Y2-Q*(X2-W2)
03300 6 END
03400
03500 INTEGER FUNCTION WX(I,J,K)
03600 WX=I
03700 IF(I.LT.J)WX=J
03800 IF(I.GT.K)WX=K
03900 END